<!--#include file="library/kfc.datatreat.asp"-->
<!--#include file="library/kfc.error.asp"-->
<!--#include file="library/kfc.db.asp"-->
<!--#include file="library/kfc.fso.asp"-->
<!--#include file="library/kfc.http.asp"-->
<!--#include file="library/kfc.json.asp"-->
<!--#include file="library/kfc.encrypt.asp"-->
<!--#include file="library/kfc.cache.asp"-->
<!--#include file="template/define.init.asp"-->
<%
'这里将预载入改为动态载入，以适应各种cms模板引擎
Dim TplType:TplType = DiscoverTemplateType
If TplType="dedecms" Then
	Include("/include/template/dedecms.asp")
ElseIf TplType="aspcms" Then
	Include("/include/template/aspcms.asp")
Else
	Include("/include/template/knifecms.asp")
End If
%>
<!--#include file="library/kfc.tpl.asp"-->
<!--#include file="library/kfc.cookie.asp"-->
<!--#include file="library/kfc.session.asp"-->
<%
'**
'系统核心类
'filename: kfc.asp
'copyright: KFC
'**
Public Function Echo(ByVal BV_String)
	Response.Write(BV_String)
End Function

Public Function Print(ByVal BV_String)
	Response.Write(BV_String)
	Response.Flush()
End Function

Public Function Die(ByVal BV_String)
	Response.Write(BV_String)
	Response.End()
End Function

Public Function DiscoverTemplateType
	
End Function

Public Function Include(filename)
	Dim re,content,fso,f,aspStart,aspEnd
	set fso=CreateObject("Scripting.FileSystemObject")
	set f=fso.OpenTextFile(server.mappath(filename))
	content=f.ReadAll
	f.close
	set f=nothing
	set fso=nothing
	set re=new RegExp
	re.pattern="^\s*="
	aspEnd=1
	aspStart=inStr(aspEnd,content,"<%")+2
	do while aspStart>aspEnd+1
		Response.write Mid(content,aspEnd,aspStart-aspEnd-2)
		aspEnd=inStr(aspStart,content,"%\>")+2
		Execute(re.replace(Mid(content,aspStart,aspEnd-aspStart-2),"Response.Write "))
		aspStart=inStr(aspEnd,content,"<%")+2
	loop
	Response.write Mid(content,aspEnd)
	set re=nothing
End Function

Sub Alert(ByVal BV_String,ByVal BV_URL)
	Dim Fn_URL
	If BV_URL &""<>"" Then
		If BV_URL = "goback" Then
			Fn_URL="history.go(-1);"
		Else
			Fn_URL="location.href='"& BV_URL &"';"
		End If
	End If
	If BV_String &""<>"" Then
		BV_String = "alert("""& BV_String &""");"
		Echo("<script type=""text/javascript"">"& BV_String & Fn_URL &"</script>")
	Else
		Echo("<script type=""text/javascript"">"& BV_String &"</script>")
	End If
End Sub

Dim KnifeCMS : Set KnifeCMS = new Class_KnifeCMS : KnifeCMS.Init()
Class Class_KnifeCMS
	Public Data,DB,DB2,FSO,Http,JSON,MD5,AES,Base64,Cache,Tpl,Cookie,[Session],[Error]
	Public SysConfig
	Public IsFSOInstalled
	Public IsRewrite,URLQueryString,RuleNumber,S_CurrentUrl
	Private S_Bom,S_CharSet,S_FSOName,S_ClassName,S_ErrMsg,S_Language,Pv_JSON,Pv_MailSetting,Pv_SystemPath
	Private Pv_ObjURLRewrite,Pv_Len,Pv_Array,Pv_ParameterValue
	Private Pv_TempString,Pv_Rule,Pv_i
	
	Private Sub Class_Initialize()
		S_CharSet	= "UTF-8"
		S_Bom		= "remove"
		S_Language  = "zh-cn"'默认语言包
		S_FSOName	= "Scripting.FileSystemObject"
		IsRewrite   = False
		RuleNumber  = 0
		Set [Error] = New Class_KnifeCMS_Error
			[Error](1)  = "The system of this server doesn't support Scripting.FileSystemObject"'此服务器系统不支持Scripting.FileSystemObject
			[Error](2)  = "File not exist!"'文件不存在！
			[Error](3)  = "Included file error!"'包含文件内部运行错误，请检查包含文件代码！
			[Error](4)  = "Reading file error, file not exist!"'读取文件错误，文件未找到！
			[Error](5)  = "KnifeCMS system path error."'KnifeCMS系统路径错误.
			[Error](6)  = "Illegal data."'非法从系统外部提交数据.
			[Error](7)  = "Save system log error."'保存日志失败.
			[Error](8)  = "KnifeCMS template not exist."'系统模版不存在.
			[Error](9)  = "Content not exist."'内容不存在.
			[Error](10) = "System application runs error!"'系统应用程序运行错误.
			[Error](11) = "Function parameter error."'函数参数错误.
		IsFSOInstalled=IsObjInstalled("Scripting.FileSystemObject")
		Set Pv_ObjURLRewrite = Server.CreateObject("Scripting.Dictionary")
		Set SysConfig = Server.CreateObject("Scripting.Dictionary")
		Set Data = New Class_KnifeCMS_Data
		'SysTime       = Data.FormatDateTime(SysTime,0)'处理时间格式,防止插入到数据库时出现无法转换成时间格式的错误
	End Sub
	
	Public Sub Init()
		Call CompileSystemConfig()
		Set DB = New Class_KnifeCMS_DB
			Pv_SystemPath = SystemPath
			'配置一个数据库
			DB.SystemPath  = SystemPath
			DB.DB_Type     = DB_Type
			Select Case DB_Type
				Case 0
					DB.DB_Server = DB_AccessFilePath
				Case 1
					DB.DB_Server = DB_Server
			End Select
			DB.DB_Port     = DB_Port
			DB.DB_Name     = DB_Name
			DB.DB_Username = DB_Username
			DB.DB_Password = DB_Password
			'*************
			DB.ShowSQL     = ShowSQL
		Set FSO   = New Class_KnifeCMS_FSO
		Set Http  = New Class_KnifeCMS_Http
		Set JSON  = New Class_KnifeCMS_JSON
		Set Cache = New Class_KnifeCMS_Cache
		    Cache.CacheFilePath = "data/cache/" '相对路径
		Set Tpl   = New Class_KnifeCMS_Template
		Set Cookie= New Class_KnifeCMS_Cookie
			Cookie.Encrypt = false '若开启Cookie加密会消耗一定系统资源并降低网页打开速度，请慎重考虑.
			Cookie.Domain  = CookieDomain
			Cookie.Path    = CookiePath
			Cookie.Secure  = false
			Cookie.CookiePre = CookiePre '如果一个虚拟目录或站点开多个knifecms系统，则每个要错开，不能定义同一个名称
			Cookie.LoginCookieTime=240 '用户登陆cookie信息保存时间,以分钟为单位
		Set [Session] = New Class_KnifeCMS_Session
			[Session].SessionPre = SessionPre '如果一个虚拟目录或站点开多个knifecms系统，则每个要错开，不能定义同一个名称
			[Session].Timeout=60 'session失效时间,以分钟为单位
		Set MD5     = New Class_MD5
		Set AES     = New Class_AES
		    AES.EncryptKey = EncryptionKey
		Set Base64  = New Class_Base64
	End Sub
	
	Private Sub Class_Terminate()
		Set [Error]  = nothing
		Set Data     = nothing
		Set DB       = nothing
		Set FSO      = nothing
		Set JSON     = nothing
		Set Cache    = nothing
		Set Tpl      = nothing
		Set Cookie   = nothing
		Set [Session]= nothing
		Set MD5      = nothing
		Set AES      = nothing
		Set Base64   = nothing
		Set Pv_ObjURLRewrite = nothing
		Set SysConfig = nothing
		Err.Clear
		On Error Goto 0
	End Sub
	
	Public Property Let FileBOM(ByVal BV_String)
		S_Bom = LCase(BV_String)
	End Property
	Public Property Get FileBOM()
		FileBOM = S_Bom
	End Property
	Public Property Let ErrMsg(ByVal BV_String)
		S_ErrMsg = LCase(BV_String)
	End Property
	Public Property Get ErrMsg()
		ErrMsg = S_ErrMsg
	End Property
	
	Public Property Let Language(ByVal Str)
		S_Language = LCase(Str)
	End Property
	Public Property Get Language()
		Language = S_Language
	End Property
	
	Public Property Get RunTime()
		 RunTime = KnifeCMS.Data.CheckSystemRuntime(Timer()-Startime)
	End Property
	
	Public Property Get CurrentUrl()
		If S_CurrentUrl="" Or IsNull(S_CurrentUrl) Then S_CurrentUrl=GetUrl("")
		CurrentUrl = S_CurrentUrl
	End Property
	
	Public Property Let CurrentUrl(ByVal BV_String)
		S_CurrentUrl = CurrentUrl
	End Property
	
	Public Property Let [CharSet](ByVal BV_String)
		S_CharSet = Ucase(BV_String)
	End Property
	Public Property Get [CharSet]()
		[CharSet] = S_CharSet
	End Property
	Public Property Let FSOName(ByVal BV_String)
		S_FSOName = BV_String
	End Property
	Public Property Get FSOName()
		FSOName = S_FSOName
	End Property
	
	Public Property Let SystemPath(ByVal BV_String)
		Pv_SystemPath = BV_String
	End Property
	
	Public Property Get SystemPath()
		SystemPath = Pv_SystemPath
	End Property
	
	Public Property Get Version()
		Version  = "v2.1"
	End Property
	Public Property Get VersionTime()
		VersionTime = "20140304"
	End Property
	
	Private Function CompileSystemConfig()
		On Error Resume Next
		If SystemConfig="" Then Exit Function
		Dim Fn_A,Fn_T,Fn_i
		Fn_A = Split(SystemConfig,";")
		For Fn_i=0 To Ubound(Fn_A)
			If Fn_A(Fn_i)<>"" Then
				Fn_T = Split(Fn_A(Fn_i),"=")
				SysConfig.Add Trim(Fn_T(0)),Trim(Fn_T(1))
			End If
		Next
		If Err.Number<>0 Then Err.Clear
	End Function
	
	Public Function IncludeLanguageFile(ByVal BV_FileName)
		On Error Resume Next
		Dim Str_FilePath
		Str_FilePath = Pv_SystemPath & "language/client/"& S_Language &"/"& BV_FileName
		Include Str_FilePath
		If Err.Number <> 0 Then
			[Error].Msg = "Error occured on getting language file."
			[Error].Raise 11
			Err.Clear
		End If
	End Function
	
	'$ 检查数据是否从系统外部提交过来的
	Public Function CheckPost()
		Dim ServerV1,ServerV2
		ServerV1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		ServerV2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(ServerV1,8,Len(ServerV2))=ServerV2 Then
			CheckPost=True
		Else
			CheckPost=False
		End If
	End Function
	
	'$ 如果非法提交数据则显示错误
	Public Function CheckPostShow()
		IF Not(CheckPost()) Then
			S_ErrMsg = S_ErrMsg & "[Local:"& Data.URLDecode(GetUrl("")) &";From:"& Cstr(Request.ServerVariables("HTTP_REFERER")) &" ]" 
			[Error].Msg = S_ErrMsg
			[Error].Raise 6
			Err.Clear
		End IF
	End Function
	
	'生成不重复的32位系统ID(重复几率小于1/1000 0000 0000 0000)
	Public Function CreateSysID()
		Dim StrSysID,STimer,LenSTimer
		StrSysID=Data.FormatDateTime(SysTime,8)
		STimer=Timer()
		STimer=Replace(STimer,".","")
		LenSTimer=Len(STimer)
		Select Case LenSTimer
			Case 6 : STimer=STimer&MakeRandom(1)
			Case 5 : STimer=STimer&MakeRandom(2)
			Case 4 : STimer=STimer&MakeRandom(3)
			Case 3 : STimer=STimer&MakeRandom(4)
			Case 2 : STimer=STimer&MakeRandom(5)
			Case 1 : STimer=STimer&MakeRandom(6)
		End Select
		StrSysID=Right(StrSysID,6)&"-"&Left(STimer,6)&"-"&int(90000*rnd)+10000&"-"&MakeRandom(5)&"-"&MakeRandom(6) '100105-442050-67349-98676-225283 共32位
		CreateSysID=StrSysID
	End Function
	
	'生成35位的Guid
	Public Function CreateGuid()
		On Error Resume Next
		Dim Fn_Guid
		Fn_Guid = Mid(Server.CreateObject("Scriptlet.TypeLib").Guid,2,36)
		Err.Clear()
		CreateGuid = Fn_Guid
	End Function
	
	Function CreateXmlDoc(ByVal BV_String)
		Set CreateXmlDoc   = Server.CreateObject(BV_String)
		CreateXmlDoc.async = False
	End Function

	Public Function Param(ByVal BV_String)
		Dim Arr(1)
		Dim L : L = Instr(BV_String,":")
		If L > 0 Then
			Arr(0) = Left(BV_String,L-1)
			Arr(1) = Mid(BV_String,L+1)
		Else
			Arr(0) = BV_String
			Arr(1) = ""
		End If
		Param = Arr
	End Function
	
	'获取客户端IP地址
	Public Function GetClientIP()
		Dim Fn_IP
		Fn_IP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
		If KnifeCMS.Data.IsNul(Fn_IP) Or LCase(Fn_IP)="unknown" Then
			Fn_IP = Request.ServerVariables("REMOTE_ADDR")
		End If
		If Not(InStr(Fn_IP,".")>0) Then Fn_IP = "0.0.0.0"
		GetClientIP = Fn_IP
	End Function
	
	'获取服务器IP地址
	Public Function GetServerIP()
		Dim Fn_IP
		Fn_IP = Request.ServerVariables("LOCAL_ADDR")
		If Not(InStr(Fn_IP,".")>0) Then Fn_IP = "0.0.0.0"
		GetServerIP = Fn_IP
	End Function
	
	Public Function GetSystemPath()
		Dim Fn_URL,Fn_Arr,Fn_T
		Fn_URL=LCase(Request.ServerVariables("URL")) '/knifecms/install/index.asp
		Fn_Arr=Split(Fn_URL,"/")
		If Ubound(Fn_Arr)>0 Then Fn_T = Trim(Fn_Arr(1))
		If Fn_T="" Or Fn_T="index.asp" Or Fn_T="install" Then
			GetSystemPath = "/"
		Else
			GetSystemPath = "/"& Fn_T &"/"
		End If
	End Function
	
	'获取支付方式/配送方式的配置参数. 示例: Partner = KnifeCMS.Payment.GetConfigParameter(Config,"Partner")
	Public Function GetConfigParameter(ByVal BV_ConfigString , ByVal BV_Parameter)
		If KnifeCMS.Data.IsNul(BV_ConfigString) Then Exit Function
		Dim Fn_Arr
		Pv_Len         = InStr(BV_ConfigString,"{")
		Pv_TempString  = Mid(BV_ConfigString,Pv_Len,Len(BV_ConfigString))
		Pv_Array       = Split(Pv_TempString,";")
		For Pv_i=0 To Ubound(Pv_Array)
			'Echo Pv_Array(Pv_i) &"<br>"
			If Not(KnifeCMS.Data.IsNul(Pv_Array(Pv_i))) Then
				Fn_Arr = Split(Pv_Array(Pv_i),":")
				If Ubound(Fn_Arr) = 2 Then
					If BV_Parameter = Mid(Fn_Arr(2),2,Len(Fn_Arr(2))-2) Then
						Fn_Arr = Split(Pv_Array(Pv_i+1),":")
						Pv_ParameterValue = Fn_Arr(2)
						Pv_ParameterValue = Mid(Pv_ParameterValue,2,Len(Pv_ParameterValue)-2)
					End If
				End If
			End If
		Next
		GetConfigParameter = Pv_ParameterValue
	End Function
	
	Public Function GetForm(ByVal FType, ByVal Element)
		On Error Resume Next
		FType=LCase(FType)
		Dim TempStr
		Select case FType
			case "get","both"
				If IsRewrite And Not(Data.IsNul(URLQueryString)) Then
					Pv_Array = Split(URLQueryString,"&")
					For Pv_i = 0 To Ubound(Pv_Array)
						Pv_Len = InStr(Pv_Array(Pv_i),"=")
						If Pv_Len > 0 Then
						    If Element = Left(Pv_Array(Pv_i),Pv_Len-1) Then TempStr = Mid(Pv_Array(Pv_i),Pv_Len+1)
						End If
					Next
				End If
				If Data.IsNul(TempStr) Then TempStr = trim(Request.QueryString(Element))
				If FType="both" And Data.IsNul(TempStr) Then TempStr = trim(Request.Form(Element))
			case "post"
				TempStr = trim(Request.Form(Element))
		End Select
		GetForm = TempStr
		If Err.Number<>0 Then Err.Clear
	End Function
	
	Public Function RequestForm(ByVal Element)
		On Error Resume Next
		RequestForm = Request.Form(Element)
		If Err.Number<>0 Then Err.Clear
	End Function
	
	'获取相关内容 BV_ID:当前文章ID,BV_Type:方式（1：标题相识，0：前后的文章）,BV_Num:数量
	Public Function GetLikeContents(ByVal BV_SubSystem,ByVal BV_ID,ByVal BV_Type,ByVal BV_Num)
		If Not(IsContentSubSystemExist(BV_SubSystem)) Then Exit Function
		Dim Fn_Rs,Fn_Sql,Fn_SqlC,Fn_Title,Fn_KeyWords,Fn_LikeIDS,Fn_Keys1,Fn_Keys2,Fn_Keys3,Fn_Keys4,Fn_Keys5
		BV_Num = KnifeCMS.Data.CLng(BV_Num)
		Fn_Sql = "SELECT TOP "&BV_Num&" ID FROM ["&TablePre&"Content_"& BV_SubSystem&"] WHERE ID<>"&BV_ID&" AND Status=1 AND Recycle=0 "
		If BV_Type = 1 Then 
			'Set Fn_Rs = KnifeCMS.DB.GetRecord(TablePre&"Content_"& BV_SubSystem &":Title",Array("ID:"&BV_ID),"")
			Set Fn_Rs = KnifeCMS.DB.GetRecordBySQL("SELECT Title FROM ["& TablePre&"Content_"& BV_SubSystem &"] WHERE ID="& BV_ID &"")
			If Not(Fn_Rs.Eof) Then
				Fn_Title = Fn_Rs(0)
			End If
			KnifeCMS.DB.CloseRs Fn_Rs
			Fn_Keys1 = Trim(Mid(Fn_Title,1,2))
			Fn_Keys2 = Trim(Mid(Fn_Title,2,2))
			Fn_Keys3 = Trim(Mid(Fn_Title,5,2))
			Fn_Keys4 = Trim(Mid(Fn_Title,7,2))
			Fn_Keys5 = Trim(Mid(Fn_Title,9,2))
			Select Case DB_Type
				Case 0
				Fn_SqlC=" AND ( Title LIKE '#"& Fn_Keys1 &"#' OR Title LIKE '#"& Fn_Keys2 &"#' OR Title LIKE '#"& Fn_Keys3 &"#' OR Title LIKE '#"& Fn_Keys4 &"#' OR Title LIKE '#"& Fn_Keys5 &"#') "
				Case 1
				Fn_SqlC=" AND ( Title LIKE '%"& Fn_Keys1 &"%' OR Title LIKE '%"& Fn_Keys2 &"%' OR Title LIKE '%"& Fn_Keys3 &"%' OR Title LIKE '%"& Fn_Keys4 &"%' OR Title LIKE '%"& Fn_Keys5 &"%') "
			End Select
			
			Set Fn_Rs = KnifeCMS.DB.GetRecordBySQL(Fn_Sql&Fn_SqlC)
			Do While Not(Fn_Rs.Eof)
				Fn_LikeIDS = Fn_LikeIDS & IIF(KnifeCMS.Data.IsNul(Fn_LikeIDS),Fn_Rs(0),","&Fn_Rs(0))
				Fn_Rs.Movenext()
			Loop
			KnifeCMS.DB.CloseRs Fn_Rs
		Else
			Fn_SqlC=" AND ID BETWEEN "&BV_ID&"-50 AND "&BV_ID&"+50 ORDER BY ABS(ID-"&BV_ID&") ASC"
			Set Fn_Rs = KnifeCMS.DB.GetRecordBySQL(Fn_Sql&Fn_SqlC)
			Do While Not(Fn_Rs.Eof)
				Fn_LikeIDS = Fn_LikeIDS & IIF(KnifeCMS.Data.IsNul(Fn_LikeIDS),Fn_Rs(0),","&Fn_Rs(0))
				Fn_Rs.Movenext()
			Loop
			KnifeCMS.DB.CloseRs Fn_Rs
		End If
		GetLikeContents = Fn_LikeIDS
	End Function
	
	'获取当前页面URL
	'GetUrl("")              http://www.KnifeCMS.com/news/index.asp?action=news&page=1&user=phenex  (包括端口和参数)
	'GetUrl(0)               /news/index.asp
	'GetUrl(1)               /news/index.asp?action=news&page=1&user=phenex
	'GetUrl(2)               /news/
	'GetUrl("action")        http://www.KnifeCMS.com/news/index.asp?action=news
	'GetUrl("action,type")   http://www.KnifeCMS.com/news/index.asp?action=news&type=
	'GetUrl("-action,-page") http://www.KnifeCMS.com/news/index.asp?user=phenex
	Public Function GetUrl(ByVal BV_UrlType)
		Dim Fn_TempUrl
		Dim Fn_i,Fn_StrHttp,Fn_StrDomain,Fn_StrPort,Fn_StrUrl,Fn_StrDir,Fn_StrParam
		If LCase(Request.ServerVariables("HTTPS"))="off" Then Fn_StrHttp="http://" : Else : Fn_StrHttp="https://" : End If
		Fn_StrDomain=Request.ServerVariables("SERVER_NAME")
		If Request.ServerVariables("SERVER_PORT")<>80 Then Fn_StrPort= ":"& Request.ServerVariables("SERVER_PORT")
		Fn_StrUrl=Request.ServerVariables("URL")
		Fn_StrDir=Left(Fn_StrUrl,InstrRev(Fn_StrUrl,"/"))
		If Trim(Request.QueryString)<>"" Then
			Fn_StrParam = "?"& Trim(Request.QueryString)
		Else
			Fn_StrParam = ""
		End If
		If Trim(BV_UrlType)<>"" Then
			BV_UrlType=Cstr(BV_UrlType)
			Select Case BV_UrlType
				Case "0"
					Fn_TempUrl = Fn_StrUrl
				Case "1"
					Fn_TempUrl = Fn_StrUrl & Fn_StrParam
				Case "2"
					Fn_TempUrl = Fn_StrDir
				Case Else
					Dim Fn_Items,Fn_QSitem
					Dim Fn_ArrType : Fn_ArrType=Split(BV_UrlType,",")
					Dim Fn_pStrParam : Fn_pStrParam = "?"
					For Fn_i=0 To Ubound(Fn_ArrType)
						Fn_QSitem=Trim(Fn_ArrType(Fn_i))
						If InStr(Fn_QSitem,"-") = 1 Then
							Fn_QSitem    = Mid(Fn_QSitem,2)
							Fn_StrParam  = Data.RegReplace(Fn_StrParam,""& Fn_QSitem &"=[^&]*","")
							Fn_StrParam  = Replace(Fn_StrParam,"?&","?")
							Fn_StrParam  = Replace(Fn_StrParam,"&&","&")
							Fn_pStrParam = Fn_StrParam
							Fn_StrParam  = Fn_pStrParam
						Else
							If Not(Data.RegTest(Fn_pStrParam,""&Fn_QSitem&"=[^&]")) Then
								Fn_QSitem = Fn_QSitem &"="& Request.QueryString(Fn_QSitem)
								If Fn_i > 0 Then Fn_QSitem = "&"& Fn_QSitem
								Fn_pStrParam = Fn_pStrParam & Fn_QSitem
							End If
						End If
					Next
					Fn_StrParam=Fn_pStrParam
					Fn_TempUrl=Fn_StrHttp & Fn_StrDomain & Fn_StrPort & Fn_StrUrl & Fn_StrParam
			End Select
		Else
			Fn_TempUrl=Fn_StrHttp & Fn_StrDomain & Fn_StrPort & Fn_StrUrl & Fn_StrParam
		End If
		GetUrl=Fn_TempUrl
	End Function
	
	'获取内容中第一张图片URL
	Public Function GetFirstImgURL(ByVal BV_String)
		Dim Fn_i,ImgUrls : ImgUrls = GetImgURL(BV_String)
		On Error Resume Next
		For Fn_i=0 To Ubound(ImgUrls)
			If Not(KnifeCMS.Data.IsNul(ImgUrls(Fn_i))) Then
				GetFirstImgURL=ImgUrls(Fn_i) : Err.Clear() : Exit Function
			End If
		Next
		If Err.Number<>0 Then GetFirstImgURL=""
		Err.Clear()
	End Function
	'只取得图片URL
	Public Function GetImgURL(ByVal BV_String)
		GetImgURL = GetImgByRegMatch(BV_String,0)
	End Function
	'取得图片(包括HTML-img标签)
	Public Function GetImgTag(ByVal BV_String)
		GetImgTag = GetImgByRegMatch(BV_String,1)
	End Function
	
	Private Function GetImgByRegMatch(ByVal BV_String, ByVal BV_Type)
		Dim Fn_Array(),Fn_i,Fn_Rule,Fn_Match,Fn_Matches
		Fn_Rule = "<img([^>]+?)(/?)>"
		Fn_i    = 0
		ReDim Fn_Array(-1)
		If Not(Data.IsNul(BV_String)) And Data.RegTest(BV_String,Fn_Rule) Then
			BV_String = Replace(BV_String,vbCrLf," ")
			BV_String = Replace(BV_String,vbTab," ")
			'regEx.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}([\w\-]+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|jpeg|jpe|bmp|png)))"
			Set Fn_Matches = Data.RegMatch(BV_String,"(<img\s[^>]*src\s*=\s*([""|']?))([^""'>]+)(\2[^>]*>)")
			For Each Fn_Match In Fn_Matches
				ReDim Preserve Fn_Array(Fn_i)
				Fn_Array(Fn_i) = KnifeCMS.IIF(BV_Type=0,Fn_Match.SubMatches(2),Fn_Match.Value)
				Fn_i = Fn_i + 1
			Next
		End If
		GetImgByRegMatch = Fn_Array
	End Function
	
	' $ 检查组件是否已经安装
	Public Function IsObjInstalled(ByVal strClassString)
		On Error Resume Next
		IsObjInstalled = False
		Err.Clear()
		Dim TestObj
		Set TestObj = Server.CreateObject(strClassString)
		If Err.Number = 0 Then IsObjInstalled = True
		Set TestObj = Nothing
		Err.Clear()
	End Function

	Function IsStringExist(ByVal BV_Content,ByVal BV_String)
        If BV_Content="" Or BV_String="" Then IsStringExist=False : Exit Function
		If Instr(BV_Content,BV_String)>0 Then IsStringExist=True
	End Function
	
	'$:Include文件,直接输出源码
	Public Sub Include(ByVal BV_FilePath)
		On Error Resume Next
		ExecuteGlobal GetIncCode(IncRead(BV_FilePath,1),0)
		If Err.Number<>0 Then
			[Error].Msg = "KnifeCMS.Include: "& BV_FilePath
			[Error].Raise 3
			Err.Clear()
		End If
	End Sub
	
	'$:Include文件,文件必须是静态文件,否则报错.
	Function GetInclude(ByVal BV_FilePath)
		On Error Resume Next
		ExecuteGlobal GetIncCode(IncRead(BV_FilePath,1),1)
		GetInclude = KnifeCMS_S_HTML
		'echo KnifeCMS_S_HTML
		If Err.Number<>0 Then
			[Error].Msg = "KnifeCMS.GetInclude:" & BV_FilePath & ""
			[Error].Raise 1
			Err.Clear()
		End If
	End Function
	
	'处理代码
	Public Function GetIncCode(ByVal Content, ByVal GetHtml)
		Dim Fn_TempString,tmpCode
		Dim Code1 : Code1 = ""
		Dim Code2 : Code2 = IIF(GetHtml=1,"KnifeCMS_S_HTML = KnifeCMS_S_HTML & ","Response.Write ")
		Dim ST : ST = 1
		Dim Enc : Enc = Instr(Content,"<%") + 2
		While Enc > ST + 1
			Fn_TempString = Mid(Content,ST,Enc-ST-2)
			ST = Instr(Enc,Content,"%"&">") + 2
			If Not(Data.IsNul(Fn_TempString)) Then
				Fn_TempString = Replace(Fn_TempString,"""","""""")
				Fn_TempString = Replace(Fn_TempString,vbCrLf,"""&vbCrLf&""")
				Code1 = Code1 & Code2 & """" & Fn_TempString & """" & vbCrLf
			End If
			Fn_TempString = Mid(Content,Enc,ST-Enc-2)
			tmpCode = Data.RegReplace(Fn_TempString,"^\s*=\s*",Code2) & vbCrLf
			If GetHtml = 1 Then
				tmpCode = Data.RegReplace(tmpCode,"Response\.Write([\( ])", Code2 & "$1",1) & vbCrLf
				tmpCode = Data.RegReplace(tmpCode,"Echo([\( ])", Code2 & "$2",1) & vbCrLf
			End If
			Code1 = Code1 & tmpCode
			Enc = Instr(ST,Content,"<%") + 2
		Wend
		Fn_TempString = Mid(Content,ST)
		If Not(Data.IsNul(Fn_TempString)) Then
			Fn_TempString = Replace(Fn_TempString,"""","""""")
			Fn_TempString = Replace(Fn_TempString,vbcrlf,"""&vbCrLf&""")
			Code1 = Code1 & Code2 & """" & Fn_TempString & """" & vbCrLf
		End If
		If GetHtml = 1 Then Code1 = "KnifeCMS_S_HTML = """" " & vbCrLf & Code1
		GetIncCode = Data.RegReplace(Code1,"(\n\s*\r)+",vbCrLf)
	End Function
	
	'$:编译源码
	Public Function IncRead(ByVal BV_String , ByVal BV_IsFilePath)
		Dim Fn_Content,Fn_Rule,Fn_Match,Fn_Include,Fn_IncludeFile,Fn_IncludeString
		If BV_IsFilePath Then Fn_Content = Read(BV_String) Else Fn_Content = BV_String
		If Data.IsNul(Fn_Content) Then Exit Function
		Fn_Content = Data.RegReplace(Fn_Content,"<% *?@.*?%"&">","")
		Fn_Content = Data.RegReplace(Fn_Content,"(<%[^>]+?)(option +?explicit)([^>]*?%"&">)","$1'$2$3")
		Fn_Rule = "<!-- *?#include +?(file|virtual) *?= *?""??([^"":?*\f\n\r\t\v]+?)""?? *?-->"
		If Data.RegTest(Fn_Content,Fn_Rule) Then
			Set Fn_Include = Data.RegMatch(Fn_Content,Fn_Rule)
			For Each Fn_Match In Fn_Include
				If LCase(Fn_Match.SubMatches(0))="virtual" Then
					Fn_IncludeFile = Fn_Match.SubMatches(1)
				Else
					Fn_IncludeFile = Mid(BV_String,1,InstrRev(BV_String,IIF(Instr(BV_String,":")>0,"\","/"))) & Fn_Match.SubMatches(1)
				End If
				Fn_IncludeString = IncRead(Fn_IncludeFile,1)
				Fn_Content = Data.ReplaceString(Fn_Content,Fn_Match.Value,Fn_IncludeString)
			Next
			Set Fn_Include = Nothing
		End If
		IncRead = Fn_Content
	End Function
	
	'$:读取文件源码
	Public Function Read(ByVal BV_FilePath)
		On Error Resume Next
		If BV_FilePath="" Then Read="" : Exit Function
		Dim Fn_TempString,Fn_FilePath : Fn_FilePath = Server.MapPath(BV_FilePath)
		If KnifeCMS.FSO.FileExists(Fn_FilePath) Then
			Dim Fn_ObjStream : Set Fn_ObjStream = Server.CreateObject("ADODB.Stream")
			With Fn_ObjStream
				.Type = 2
				.Mode = 3
				.Charset = S_CharSet
				.Open
				.LoadFromFile Fn_FilePath
				.Position = 0
				 Fn_TempString = .ReadText
				.Close
			End With
			Set Fn_ObjStream = Nothing
			
			'If S_CharSet = "UTF-8" Then
			'	Select Case KnifeCMS.FileBOM
			'		Case "keep"
			'		Case "remove"
			'			If Test(Fn_TempString,"^\uFEFF") Then
			'				Fn_TempString = RegReplace(Fn_TempString, "^\uFEFF", "")
			'			End If
			'		Case "add"
			'			If Not Test(Fn_TempString, "^\uFEFF") Then
			'				Fn_TempString = Chrw(&hFEFF) & Fn_TempString
			'			End If
			'	End Select
			'End If
		Else
			Fn_TempString = ""
			[Error].Msg = "KnifeCMS.Read: "& BV_FilePath &""
			[Error].Raise 2
			Err.Clear
		End If
		Read = Fn_TempString
	End Function
	
	Public Function MakeRandom(ByVal maxLen)
		Dim strNewPass,whatsNext,upper,lower,intCounter
		Randomize
		For intCounter = 1 To maxLen
		upper = 57
		lower = 48
		strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
		Next
		MakeRandom = strNewPass
	End Function
	
	
	'获取系统邮件配置信息
	Public Function GetEmailConfig()
		On Error Resume Next
		Set Pv_JSON = KnifeCMS.JSON.Parse(MailConfig)
		ReDim Pv_MailSetting(5,0)
		Pv_MailSetting(0,0) = Pv_JSON.smtp
		Pv_MailSetting(1,0) = Pv_JSON.mailserver_username
		Pv_MailSetting(2,0) = Pv_JSON.mailserver_password
		Pv_MailSetting(3,0) = Pv_JSON.from
		Pv_MailSetting(4,0) = KnifeCMS.Data.HTMLDecode(Pv_JSON.fromname)
		Set Pv_JSON = Nothing
		Err.Clear()
	End Function
	
	'发送邮件
	'KnifeCMS.SendEmail(Array("smtp.exmail.qq.com","support01@knifecms.com","support01email110","support01@knifecms.com","美约客服"),Array("hr@miiyee.com","收件人"),"邮件标题","邮件内容")
	'KnifeCMS.SendEmail(Array("美约客服"),Array("hr@miiyee.com","收件人"),"邮件标题","邮件内容")
	'KnifeCMS.SendEmail("",Array("hr@miiyee.com","收件人"),"邮件标题","邮件内容")
	'KnifeCMS.SendEmail("","hr@miiyee.com","邮件标题","邮件内容")
	
	Public Function SendEmail(ByVal BV_From, ByVal BV_Recipient, ByVal BV_Subject, ByVal BV_Body)
		On Error Resume Next
		Dim Fn_IsCircle : Fn_IsCircle = True
		Dim Fn_SMTP,Fn_MSUserName,Fn_MSPassword,Fn_From,Fn_FromName,Fn_RecEmail,Fn_RecName
		Dim Fn_DataNum,Fn_ii,Fn_jj,Fn_Result : Fn_Result = False
		
		'是否已指定发送邮件配置，若已指定则不再使用系统的邮件配置
		If IsArray(BV_From) Then
			If Ubound(BV_From)>=2 Then Fn_IsCircle = False
		End If
		'收件人
		If IsArray(BV_Recipient) Then
			Fn_RecEmail = BV_Recipient(0)
			Fn_RecName  = BV_Recipient(1)
		Else
			Fn_RecEmail = BV_Recipient
		End If
		
		'--循环--
		Call GetEmailConfig()
		Fn_DataNum = -1
		If IsArray(Pv_MailSetting) Then Fn_DataNum=Ubound(Pv_MailSetting,2)
		If Fn_IsCircle = False Then Fn_DataNum=0
		For Fn_ii=0 To Fn_DataNum
			'系统默认邮件配置
			Fn_SMTP       = Pv_MailSetting(0,Fn_ii)
			Fn_MSUserName = Pv_MailSetting(1,Fn_ii)
			Fn_MSPassword = Pv_MailSetting(2,Fn_ii)
			Fn_From       = Pv_MailSetting(3,Fn_ii)
			Fn_FromName   = Pv_MailSetting(4,Fn_ii)
			'指定发送邮件配置
			If IsArray(BV_From) Then
				If Ubound(BV_From)>=2 Then
					Fn_SMTP       = BV_From(0)
					Fn_MSUserName = BV_From(1)
					Fn_MSPassword = BV_From(2)
					Fn_From       = BV_From(3)
					Fn_FromName   = BV_From(4)
				Else
					Fn_FromName   = BV_From(0)
				End If
			End If
			'发送邮件
			Fn_Result = SendEmailing(Fn_SMTP, Fn_MSUserName, Fn_MSPassword, Fn_From, Fn_FromName, Fn_RecEmail, Fn_RecName, BV_Subject, BV_Body)
			'echo "<br>"& Fn_SMTP&"  -  "&Fn_MSUserName&"  -  "&Fn_MSPassword&"  -  "&Fn_From&"  -  "&Fn_FromName&"  -  "&Fn_RecEmail&"  -  "&Fn_RecName&"  -  "&BV_Subject&"  -  "&BV_Body
			'echo "<br>发送 "& Fn_ii+1 &" 次_"& Fn_Result : response.Flush()
			If Fn_Result=True Then Exit For
		Next
		If Err.Number<>0 Then Err.Clear() : Fn_Result = "error_server"
		SendEmail = Fn_Result
	End Function
	
	'KnifeCMS.SendEmailing("smtp.exmail.qq.com","admin@knifecms.com","password","admin@knifecms.com","admin","ck@kfc.net","ck","邮件主题","邮件内容")
	Public Function SendEmailing(ByVal BV_SMTP,ByVal BV_MSUserName,ByVal BV_MSPassword, ByVal BV_From, ByVal BV_FromName, ByVal BV_RecEmail, ByVal BV_RecName, ByVal BV_Subject, ByVal BV_Body)
		'@ BV_SMTP        邮件服务器[不能为空]
		'@ BV_MSUserName  邮件服务器登陆帐号[不能为空]
		'@ BV_MSPassword  邮件服务器登陆密码[不能为空]
		'@ BV_From        发件人邮箱[不能为空]
		'@ BV_FromName    发件人名称[可空]
		'@ BV_RecEmail    收件人邮箱[不能为空]
		'@ BV_RecName     收件人名字[可空]
		'@ BV_Subject     邮件标题[不能为空]
		'@ BV_Body        邮件内容[不能为空]
		'当收信人地址不存在或发送邮件的帐号被当作垃圾邮件帐号的时候均可能出现error
		On Error Resume Next
		Dim Fn_Mail,Fn_JMail,Fn_Result : Fn_Result = False
		Fn_Mail = "jmail"
		Select Case Fn_Mail
		Case "jmail"
			Set Fn_JMail = Server.CreateObject("JMail.Message")
			If Err.Number<>0 Then
				Err.Clear()
				SendEmailing="error_jmail_not_installed"
				Exit Function
			End If
			Fn_JMail.Charset           = S_CharSet'"UTF-8"
			Fn_JMail.ContentType       = "text/html"
			Fn_JMail.From              = BV_From
			Fn_JMail.FromName          = BV_FromName
			If BV_RecName="" Then
				Fn_JMail.AddRecipient BV_RecEmail
			Else
				Fn_JMail.AddRecipient BV_RecEmail,BV_RecName
			End If
			Fn_JMail.Subject            = BV_Subject
			Fn_JMail.HTMLBody           = BV_Body
			Fn_JMail.MailServerUserName = BV_MSUserName
			Fn_JMail.MailServerPassword = BV_MSPassword
			Fn_Result = Fn_JMail.Send(BV_SMTP)
			Fn_JMail.Close()
			Set Fn_JMail = Nothing
			If Err.Number<>0 Then
				Err.Clear()
				Fn_Result = "error_send_email_fail"
			End If
		Case "cdonts"
		Case "aspemail"
		End Select
		SendEmailing = Fn_Result
	End Function

	'添加页面伪静态规则
	Public Function RewriteRule(ByVal BV_Rule, ByVal BV_QueryString)
		RuleNumber = RuleNumber + 1
		Pv_ObjURLRewrite.Add ("rule"&RuleNumber),Array(BV_Rule,BV_QueryString)
	End Function
	
	Public Function ParseRewrite()
		Dim Fn_Rule,Fn_Matche,Fn_Matches,Fn_SubMatche,Fn_QueryValue
		If RuleNumber=0 Or Data.IsNul(Pv_ObjURLRewrite) Then Exit Function
		For Each Fn_Rule In Pv_ObjURLRewrite
			Pv_Rule = Pv_ObjURLRewrite(Fn_Rule)(0)
			If Data.RegTest(CurrentURL,Pv_Rule) Then
				IsRewrite      = True
				Fn_QueryValue  = Pv_ObjURLRewrite(Fn_Rule)(1)
				Set Fn_Matches = Data.RegMatch(CurrentURL,Pv_Rule)
				If Fn_Matches.Count > 0 Then Pv_TempString = Fn_Matches(0).Value
				For Each Fn_Matche In Fn_Matches
					Pv_i = 0
					For Each Fn_SubMatche In Fn_Matche.SubMatches
						Pv_i = Pv_i + 1
						Fn_QueryValue = Data.RegReplace(Fn_QueryValue,"(\$"& Pv_i &")",Fn_SubMatche)
					Next
				Next
				URLQueryString = Fn_QueryValue
				'Echo URLQueryString &"<br>"
			End If
		Next
	End Function
	
	'返回安全的用户登陆/注册时提交的用户名
	Public Function ParseUserName(ByVal BV_UserName)
		ParseUserName = Data.Left(Data.HTMLEncode(BV_UserName),15)
	End Function
	'加密处理用户登陆/注册时提交的密码
	Public Function ParsePassWord(ByVal BV_PassWord)
		ParsePassWord = MD5.Encrypt(AES.Encrypt(Data.Left(BV_PassWord,20)))
	End Function
	
	'过滤禁止的文件夹字符
	Public Function ParseFilePath(ByVal BV_Path)
		Dim Fn_Path : Fn_Path = BV_Path
		Fn_Path=Replace(Fn_Path,"*","")
		Fn_Path=Replace(Fn_Path,"?","")
		Fn_Path=Replace(Fn_Path,"""","")
		Fn_Path=Replace(Fn_Path,"|","")
		Fn_Path=Replace(Fn_Path,"<","")
		Fn_Path=Replace(Fn_Path,">","")
		'Fn_Path=Replace(Fn_Path,"\","")绝对路径必须允许这两个字符
		'Fn_Path=Replace(Fn_Path,":","")
		ParseFilePath = Fn_Path
	End Function
	
	Function IIF(ByVal Expression, ByVal TrueResult, ByVal FalseResult)
		On Error Resume Next
		If Expression Then
			IIF = TrueResult
		Else
			IIF = FalseResult
		End If
		If Err.Number<>0 Then Err.Clear
	End Function

End Class
%>